home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-19 / l2c-19.exe / DEMO.LSP < prev    next >
Lisp/Scheme  |  1993-06-25  |  1KB  |  55 lines
  1. (defun Qsort (lst / x l e g)
  2.   (if lst
  3.    (progn
  4.     (setq x (nth (/ (length lst) 2) lst)
  5.           l nil e nil g nil)
  6.  
  7.     (while (not (null lst))
  8.       (cond ((= (car lst) x) (setq e (cons x e)))
  9.             ((< (car lst) x) (setq l (cons (car lst) l)))
  10.             (t (setq g (cons (car lst) g)))
  11.       )
  12.       (setq lst (cdr lst))
  13.     )
  14.     (setq l (Qsort l)
  15.           g (Qsort g))
  16.     (append l e g)
  17.    )
  18.    nil
  19.   )
  20. )
  21.  
  22. (defun c:stat ()
  23.   (mem)
  24. )
  25.  
  26. (defun c:gc ()
  27.   (gc)
  28. )
  29.  
  30. (defun c:interpreter ( / cmd num)
  31.   (princ "\nVoid input returns you to an AutoLISP.")
  32.   (initget 128)
  33.   (setq num 1)
  34.   (setq cmd (getpoint (strcat "\nCommand #" (itoa num) ": ")))
  35.   (while (and (equal (type cmd) 'STR)(not (equal cmd "")))
  36.      (print (eval (read cmd)))
  37.      (initget 128)
  38.      (setq num (1+ num)
  39.            cmd (getpoint (strcat "\nCommand #" (itoa num) ": ")))
  40.   )
  41.   (princ)
  42. )
  43. (defun S::l2cstartup ()
  44.   (princ "\nLisp2Cads *demo* file")
  45.   (princ "\nNew commands:")
  46.   (princ "\n   INTERPRETER evaluates Lisp expressions")
  47.   (princ "\n   GC          invokes garbage collector")
  48.   (princ "\n   STAT        displays memory usage statistics")
  49.   (princ "\nNew function:")
  50.   (princ "\n   (QSORT list) sorts list of elements in ascending order")
  51.   (princ "\n\nThis is S::L2CSTARTUP function, automatically invoked when")
  52.   (princ "\nan application is XLOADed.")
  53.   (princ "\nHave a nice day!")
  54. )
  55.